Below are listed the receivers with the status = lost/broken that could be found in the deployments.
19 receivers did not have any deployment information or the year they were lost associated. They are listed in the table below.
---
title: "VLIZ lost equipment in the BPNS"
output:
flexdashboard::flex_dashboard:
source_code: embed
orientation: rows
vertical_layout: scroll
theme:
version: 4
bootswatch: litera
editor_options:
chunk_output_type: console
---
<!-- flexdashboard YAML settings: -->
<!-- output: html_document -->
<!-- editor_options: -->
<!-- chunk_output_type: console -->
<!-- README: -->
<!-- * This script produces an R flexdashboard showing overview maps and tables about lost equipment in the Belgian Part of the North Sea (BPNS), that is, acoustic receivers, CPODs, soundtraps and hydrophones. -->
<!-- * To retrieve metadata on acoustic receivers (that are part of the European Tracking Network ETN), the 'etn' R package is used. -->
<!-- * Metadata on the remaining hydroacoustic equipment is not programmatically retrievable at the time of writing (November, 2023) and will thus be loaded from a .csv file. -->
<!-- * Author: Lotte Pohl, Date: 2023-11-07, E-Mail: lotte.pohl at gmail.com -->
```{r setup, include=FALSE, echo = F}
# knitr::opts_chunk$set(echo = F)
# Sys.setlocale("LC_TIME", "English") # language = English, does not work right now
# fundamentals
library(flexdashboard)
library(etn)
library(knitr)
# data wrangling
library(readr)
# library(tidyverse)
library(lubridate)
library(dplyr)
library(lubridate)
library(utils)
library(purrr)
# maps
library(leaflet)
library(leafem)
# spatial operations & tools
library(mregions2)
library(sf)
# devtools::install_github("EMODnet/EMODnetWFS")
library(EMODnetWFS)
# plotting and tables
library(DT) # for interactive tables
options(DT.options = list(dom = 'Bfrtip',
buttons = c('pdf', 'csv', 'excel', 'print','copy'),
scrollY="500px",
scrollX="100px",
pageLength = 13,
autoWidth = TRUE))
library(ggplot2)
library(kableExtra)
library(plotly)
library(scico) #colour palettes
# database connection
con <- etn::connect_to_etn(Sys.getenv("userid"), Sys.getenv("pwd"))
# functions to save queried data as .rds files
save_data <- function(data, folder){
base::saveRDS(data, file = paste0(folder, deparse(substitute(data)), ".rds"))
}
# load rds data ####
load_data <- function(filestring, folder){
data <- base::readRDS(file = paste0(folder, filestring, ".rds"))
return(data)
}
```
```{r query windfarm and power cable data, include=FALSE, echo=FALSE}
# # only execute this chunk when querying the data for the first time, afterwards the data will be loaded
#
data_path <- paste0(getwd(), "/data/")
#
# # Windfarms and power cables
# wfs_human <- EMODnetWFS::emodnet_init_wfs_client(service = "human_activities")
# # wfs_human %>% emodnet_get_wfs_info() %>% View() #inspect available layers to query
#
# layers_windfarms <-
# wfs_human %>%
# EMODnetWFS::emodnet_get_layers(layers = c("windfarmspoly"), crs = 4326)
#
# windfarms_polygons <-
# layers_windfarms %>%
# purrr::pluck("windfarmspoly") %>%
# dplyr::filter(country %in% c("Belgium")) #, "Netherlands"
#
# save_data(data = windfarms_polygons, folder = data_path)
#
# # layers_cables <- # belgian power cables are apparently not included in the data
# # wfs_human %>%
# # EMODnetWFS::emodnet_get_layers(layers = c("pcablesrijks", "pcablesbshcontis"), crs = 4326)
# #
# # pcablesrijks <-
# # layers_cables %>%
# # purrr::pluck("pcablesrijks") %>%
# # mutate(name = "pcablesrikjs") %>%
# # dplyr::select(name, the_geom)
# # save_data(data = pcablesrijks, folder = data_path)
```
```{r query additional info, include=FALSE, echo=FALSE}
# Belgian EEZ
BPNS <- mregions2::gaz_search(3293) %>% mregions2::gaz_geometry()
# load Windfarm polygons
windfarms_polygons <- load_data(filestring = "windfarms_polygons", folder = data_path)
```
```{r ETN database query, include=FALSE, echo=FALSE}
# in this code chunk, metadata on the lost and broken acoustic receivers, and acoustic deployment data are retrieved
# ACOUSTIC DEPLOYMENTS
all_deployments <-
etn::get_acoustic_deployments(con) %>%
dplyr::filter(!is.na(deploy_longitude) & !is.na(deploy_latitude)) #%>%
# sf::st_as_sf(., coords = c("deploy_longitude", "deploy_latitude"), crs = 4326)
all_deployments_sf <-
all_deployments %>%
sf::st_as_sf(., coords = c("deploy_longitude", "deploy_latitude"), crs = 4326)
within_BPNS <-
sf::st_within(all_deployments_sf, BPNS) %>% # get back list with TRUE or FALSE is deployment location is within BPNS boundaries
apply(., 1, any)
deployments_BPNS <-
all_deployments %>%
dplyr::mutate(within_BPNS = within_BPNS) %>%
dplyr::filter(within_BPNS == TRUE) %>% # filter out all deployments outside of the BPNS
dplyr::mutate(year = deploy_date_time %>% lubridate::year())
rm(all_deployments); rm(all_deployments_sf); rm(within_BPNS) # remove files that are not needed anymore
## last deployments
last_deployments <- # get summary of all last deployments to then join with the lost/broken receivers
deployments_BPNS %>%
dplyr::group_by(receiver_id) %>%
dplyr::summarise(deploy_date_time = deploy_date_time %>% max(na.rm = T)) %>%
dplyr::left_join(deployments_BPNS %>%
dplyr::select(receiver_id, deployment_id, deploy_date_time, station_name, deploy_latitude, deploy_longitude,
mooring_type, acoustic_project_code, recover_date_time, comments),
by = join_by(receiver_id, deploy_date_time))
## deployments summarised per receiver station
stations_BPNS <-
deployments_BPNS %>%
dplyr::group_by(station_name, year) %>%
dplyr::summarise(n_deploy = dplyr::n(),
n_receivers = receiver_id %>% unique() %>% length(),
deploy_latitude = deploy_latitude %>% mean(na.rm = T),
deploy_longitude = deploy_longitude %>% mean(na.rm = T)) %>%
dplyr::mutate(years = paste(year, collapse = ", "),
n_deployments = paste(n_deploy, collapse = ", ")) %>%
dplyr::ungroup()
stations_BPNS <-
stations_BPNS %>%
dplyr::group_by(station_name) %>% # collapse information per year
dplyr::summarise(deploy_latitude = deploy_latitude %>% mean(),
deploy_longitude = deploy_longitude %>% mean(),
years = years %>% unique(),
n_deployments = n_deployments %>% unique()) %>%
dplyr::left_join(deployments_BPNS %>% # get overall stats: total n of deployments, start and end of last deployment
dplyr::group_by(station_name) %>%
dplyr::summarise(n_total_deploy = dplyr::n(),
last_deploy_start = deploy_date_time %>% max() %>% as.Date(),
last_deploy_end = recover_date_time %>% max() %>% as.Date()),
by = join_by(station_name))
# ACOUSTIC RECEIVERS
lost_receivers <-
etn::get_acoustic_receivers(con, status = c("lost", "broken")) %>%
dplyr::filter(owner_organization == "VLIZ") %>%
dplyr::select(!tidyr::starts_with("ar_")) %>%
dplyr::left_join(last_deployments,
by = join_by(receiver_id)) %>%
dplyr::select(!c(modem_address, battery_estimated_life, owner_organization, financing_project, built_in_acoustic_tag_id)) %>%
dplyr::mutate(year = lubridate::year(deploy_date_time) %>% factor()) %>%
dplyr::relocate(year, .before = receiver_id) %>%
dplyr::arrange(desc(year))
lost_receivers_per_station <-
lost_receivers %>%
dplyr::filter(!is.na(deploy_date_time)) %>%
dplyr::group_by(station_name, year) %>%
dplyr::summarise(n_receivers = receiver_id %>% unique() %>% length(),
deploy_latitude = deploy_latitude %>% mean(na.rm = T),
deploy_longitude = deploy_longitude %>% mean(na.rm = T)) %>%
dplyr::mutate(years = paste(year, collapse = ", "),
n_receivers_lost = paste(n_receivers, collapse = ", ")) %>%
dplyr::ungroup()
lost_receivers_per_station <-
lost_receivers_per_station %>%
dplyr::group_by(station_name) %>%
dplyr::summarise(deploy_latitude = deploy_latitude %>% mean(),
deploy_longitude = deploy_longitude %>% mean(),
years = years %>% unique(),
n_receivers_lost = n_receivers_lost %>% unique()) %>%
dplyr::left_join(lost_receivers %>%
dplyr::group_by(station_name) %>%
dplyr::summarise(n_total_lost = dplyr::n(),
last_deploy_start = deploy_date_time %>% max() %>% as.Date(),
last_deploy_end = recover_date_time %>% max() %>% as.Date()),
by = join_by(station_name))
lost_receivers_without_station <- # some acoustic receivers have no deployment information connected to them
lost_receivers %>%
dplyr::filter(is.na(deploy_date_time)) %>%
dplyr::select(receiver_id, manufacturer, receiver_model, receiver_serial_number, status)
```
<!-- Overview: Receiver stations -->
<!-- ===================================== -->
Row {data-height=500}
-------------------------------------
### Map lost acoutic receivers {data-width=700}
```{r map}
#, include=T, echo=F
# EMODnet Bathymetry layer
emodnet_tiles <-"https://tiles.emodnet-bathymetry.eu/2020/baselayer/web_mercator/{z}/{x}/{y}.png"
cite_emodnet <- "<a href='https://emodnet.ec.europa.eu'>EMODnet</a>"
attr(cite_emodnet, "class") <- c("html", "character")
## North Arrow
north.arrow.icon <-
"<img src='https://www.clipartbest.com/cliparts/yTo/Lgr/yToLgryGc.png' style='width:40px;height:50px;'>"
# special icons
# icon_tag <- leaflet::makeAwesomeIcon(
# icon = "tag",
# iconColor = "black",
# markerColor = "yellow",
# library = "fa"
# )
# map
leaflet() %>%
leaflet::addTiles(urlTemplate = emodnet_tiles,
# options = leaflet::tileOptions(tms = FALSE),
attribution = cite_emodnet,
group = "EMODnet bathymetry") %>%
leaflet::addTiles(group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", options = providerTileOptions(opacity = 0.6), group = "satellite") %>%
# additional layers for context (belgian EEZ and winfarms)
addPolygons(data = BPNS, color = "darkgrey",
weight = 2,
opacity = 1.0,
# popup = ~preferredGazetteerName,
fillOpacity = 0) %>%
addPolygons(data = windfarms_polygons, color = "darkblue",
weight = 2,
opacity = 1.0,
# popup = ,
fillOpacity = 0) %>%
# acoustic deployments
addCircleMarkers(data = stations_BPNS,
lat = ~deploy_latitude,
lng = ~deploy_longitude,
radius = ~(log(n_total_deploy) * 1.5) + 2,
color = "black",
opacity = 1,
weight = 2,
fillOpacity = 0.4,
fillColor = "black",
label = ~paste0("station ", station_name),
# popup = ~paste0("lat: ", deploy_latitude, ", lon: ", deploy_longitude),
popup = ~paste(
"<br>", "<b>Station:</b> ", station_name, "<br>",
"<b>Total # of deployments:</b> ", n_total_deploy, "<br>",
"<b>Deployment years:</b> ", years, "<br>",
"<b># deployments per year:</b> ",n_deployments, "<br>",
"<b>Last deployment:</b> ", last_deploy_start, " - ", last_deploy_end, "<br>" #,
# "<br>", "<b>Ac. proj. code:</b> ", acoustic_project_code,
),
group = "acoustic deployments"
) %>%
# lost receivers
addCircleMarkers(data = lost_receivers_per_station,
lat = ~deploy_latitude,
lng = ~deploy_longitude,
radius = ~(log(n_total_lost) * 2.5) + 3,
color = "red",
weight = 1,
fillOpacity = 1,
fillColor = "red",
label = ~paste0("station ", station_name),
# popup = ~paste0("lat: ", deploy_latitude, ", lon: ", deploy_longitude),
popup = ~paste(
"<br>", "<b>Station:</b> ", station_name, "<br>",
"<b>Total # of lost receivers:</b> ", n_total_lost, "<br>",
"<b>Years:</b> ", years, "<br>",
"<b># receivers lost per year:</b> ",n_receivers_lost, "<br>" #,
# "<b>Last deployment:</b> ", last_deploy_start, " - ", last_deploy_end, "<br>" #,
# "<br>", "<b>Ac. proj. code:</b> ", acoustic_project_code,
),
# group = "lost acoustic receivers"
group = "<span style=color:red>lost acoustic receivers</span>"
) %>%
# add-ons
leaflet.extras::addFullscreenControl() %>%
leafem::addMouseCoordinates() %>%
addScaleBar(position = "bottomright",
options = scaleBarOptions(
maxWidth = 150,
imperial = FALSE)) %>%
addControl( html = north.arrow.icon,
position = "topleft",
className = "fieldset {border: 0;}") %>%
# layers control
addLayersControl(position = "topright" ,
baseGroups = c("EMODnet bathymetry", "satellite", "OpenStreetMap"),
overlayGroups = c("acoustic deployments", "<span style=color:red>lost acoustic receivers</span>"),
options = layersControlOptions(collapsed = FALSE)) %>%
# legend
addLegend(position = "bottomleft",
colors = c("darkgrey","darkblue"),
labels = c("Belgian EEZ", "Belgian Offshore Wind Farms"),
opacity = 1)
```
### side row {data-width=300}
```{r abacus}
```
Row {data-height=800}
-------------------------------------
### Table containing info on lost receivers and last deployment
Below are listed the receivers with the `status = lost/broken` that could be found in the deployments.
```{r table}
# DT::datatable(lost_receivers %>%
# dplyr::filter(!is.na(deploy_date_time)) %>%
# dplyr::select(!manufacturer) %>%
# dplyr::mutate(deploy_date_time = deploy_date_time %>% as.Date()),
# rownames = F,
# filter = 'top',
# extension = 'Buttons',
# options = list(
# dom = 'Bfrtip',
# buttons = c('pdf', 'csv', 'excel', 'print','copy'),
# pageLength = 20,
# autoWidth = TRUE,
# scrollX='500px')
# # ,columnDefs = list(list(width = '400px', targets = list(15))
# )
DT::datatable(lost_receivers %>%
dplyr::filter(!is.na(deploy_date_time)) %>%
dplyr::select(!manufacturer) %>%
dplyr::mutate(deploy_date_time = deploy_date_time %>% as.Date()),
rownames = F,
filter = 'top',
extension = 'Buttons',
# options = list(pagelength = 10)
# ,options = list(
# dom = 'Bfrtip',
# buttons = c('pdf', 'csv', 'excel', 'print','copy'),
# # pageLength = 20,
# autoWidth = TRUE
# # ,scrollX = TRUE
# )
)
```
Row {data-height=800}
-------------------------------------
### Table containing info on lost receivers without deployment
`r lost_receivers_without_station %>% nrow()` receivers did not have any deployment information or the year they were lost associated. They are listed in the table below.
```{r table lost receivers without station}
DT::datatable(lost_receivers_without_station,
rownames = F,
filter = 'top',
extension = 'Buttons'
# ,options = list(
# dom = 'Bfrtip',
# buttons = c('pdf', 'csv', 'excel', 'print','copy'),
# # pageLength = 20,
# autoWidth = TRUE
# # ,scrollX='20%'
# )
)
```
<!-- Details: Acoustic Projects & Detections -->
<!-- ===================================== -->
<!-- <style> -->
<!-- .datatables{ -->
<!-- overflow: auto; -->
<!-- } -->
<!-- </style> -->